home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / simcode.arc / MENUIT.PAS < prev    next >
Pascal/Delphi Source File  |  1984-12-03  |  8KB  |  291 lines
  1. {$symtab-,$pagesize:86,$linesize:131,$debug-,
  2. $title:'MENUIT -- Create menus'}
  3. {    COPYRIGHT @ 1982
  4.     Jim Holtman and Eric Holtman
  5.     35 Dogwood Trail
  6.     Randolph, NJ 07869
  7.     (201) 361-3395
  8. }
  9. {$line+}
  10.  
  11.  module menus;
  12.  
  13.     type
  14.        menu_c = super array [1..*] of lstring(40);
  15.        screen = array[1..25] of array[1..160] of byte;
  16.        screen_buffer = array[1..4000] of byte;
  17.  
  18.     var
  19.        snapscreen : array[1..20] of ^screen_buffer;
  20.        snapptr : integer;
  21.        snapx, snapy : array[1..20] of integer;
  22.        value snapptr := 1;
  23. {$include:'graph.inc'}
  24. { Two routine that can take a snapshot of screen w/cursor and
  25.   then later restore the snapshot }
  26.  
  27.     procedure pushscreen [public];
  28.  
  29.        var
  30.       x : ads of char;
  31.       display_buffer_addr [external] : word;
  32.  
  33.        begin
  34.       x.s := display_buffer_addr;
  35.       x.r := 0;
  36.       new(snapscreen[snapptr]);
  37.       movesl(x, ads snapscreen[snapptr]^, 4000);
  38.       xrcurp(snapx[snapptr], snapy[snapptr]);
  39.       snapptr := snapptr + 1;
  40.       end;
  41.  
  42.     procedure popscreen [public];
  43.  
  44.        var
  45.       x : ads of char;
  46.       display_buffer_addr [external] : word;
  47.  
  48.        begin
  49.       x.s := display_buffer_addr;
  50.       x.r := 0;
  51.       if (snapptr = 1) then return;
  52.       snapptr := snapptr - 1;
  53.       movesl(ads snapscreen[snapptr]^, x, 4000);
  54.       xxmove(snapx[snapptr], snapy[snapptr]);
  55.       dispose(snapscreen[snapptr]);
  56.       end;
  57.  
  58.     procedure chattr(newattr : byte;
  59.      y, sx, ex : integer);
  60.  
  61.        var
  62.       i,j : integer;
  63.       scr : ads of screen;
  64.       display_buffer_addr [external] : word;
  65.  
  66.        begin
  67.       scr.s := display_buffer_addr;
  68.       scr.r := 0;
  69.       for i := sx to ex do scr^[y,i*2] := newattr;
  70.       end;
  71.  
  72.     procedure errormsg(y, att : integer);
  73.  
  74.        var
  75.       errmsg : lstring(80);
  76.  
  77.        begin
  78.       errmsg :=
  79. '  Use arrows to make choice, then hit space bar. Use ESC to make "no choice"  '
  80.            ;
  81.       xxmove(40 - ord(errmsg.len) div 2, y);
  82.       xttywrt(errmsg, att);
  83.       end;
  84.  
  85.     procedure show(y : integer);
  86.  
  87.        var
  88.       errmsg : lstring(80);
  89.  
  90.        begin
  91.       errmsg := '  Hit space or ESC to return to Simterm Operation  ';
  92.       xxmove(40 - ord(errmsg.len) div 2, y);
  93.       xttywrt(errmsg, #70);
  94.       end;
  95.  
  96.     function menuit(var choices : menu_c;
  97.      const title : lstring ) : integer [public];
  98.  
  99.        var
  100.       max_len : integer;
  101.       max_items : integer;
  102.       i,j,k : integer;
  103.       x,y : integer;
  104.       sx, sy : integer;
  105.       scr : ads of screen;
  106.       ch : char;
  107.  
  108.        begin
  109.       pushscreen;
  110.       max_len := 2 + ord(title.len);
  111.       for i := 1 to upper(choices) do begin
  112.          if (choices[i].len = 0) then break;
  113.          if (ord(choices[i].len) > max_len) then max_len := ord(choices[i].
  114.           len);
  115.          end;
  116.       max_items := i-1;
  117.       if (max_items = 0) then begin
  118.          menuit := 0;
  119.          return;
  120.          end;
  121.       max_len := max_len + 2;
  122.       sx := 40 - ((max_len + 2) div 2);
  123.       sy := 12 - ((max_items + 2) div 2);
  124.       xxmove(sx,sy-2);
  125.       xttywrt('╔',7);
  126.       for i := 1 to max_len do xttywrt('═',7);
  127.       xttywrt('╗',7);
  128.       xxmove(sx,sy-1);
  129.       xwca(#700, max_len+1);
  130.       xxmove(40 - (ord(title.len) div 2), sy-1);
  131.       xttywrt(title, 7);
  132.       xxmove(sx,sy-1);
  133.       xttywrt('║',7);
  134.       xxmove(sx+max_len+1, sy-1);
  135.       xttywrt('║',7);
  136.       xxmove(sx,sy);
  137.       xttywrt('╠',7);
  138.       for i := 1 to max_len do xttywrt('═',7);
  139.       xttywrt('╣',7);
  140.       for i := 1 to max_items do begin
  141.          xxmove(sx,sy+i);
  142.          xwca(#700, max_len+1);
  143.          xxmove(sx,sy+i);
  144.          xttywrt('║',7);
  145.          xxmove(40 - (ord(choices[i].len) div 2), sy+i);
  146.          xttywrt(choices[i], 7);
  147.          xxmove(sx+max_len+1,sy+i);
  148.          xttywrt('║',7);
  149.          end;
  150.       xxmove(sx,sy+1+max_items);
  151.       xttywrt('╚',7);
  152.       for i := 1 to max_len do xttywrt('═',7);
  153.       xttywrt('╝',7);
  154.       i := 1;
  155.       chattr(#70, 1+i+sy, sx+2, sx+1+max_len);
  156.       errormsg(sy+2+max_items, #70);
  157.       while (xxinkey(ch) = 0) do begin
  158.          end;
  159.       while ((ch <> ' ') and (ch <> chr(27))) do begin
  160.          case ord(ch) of
  161.         72: begin
  162.            chattr(7, 1+i+sy, sx+2, sx+1+max_len);
  163.            i := i - 1;
  164.            if (i = 0) then i := max_items;
  165.            chattr(#70, 1+i+sy, sx+2, sx+1+max_len);
  166.            end;
  167.         80: begin
  168.            chattr(7, 1+i+sy, sx+2, sx+1+max_len);
  169.            i := i + 1;
  170.            if (i = max_items + 1) then i := 1;
  171.            chattr(#70, 1+i+sy, sx+2, sx+1+max_len);
  172.            end;
  173.         otherwise ;
  174.         end;
  175.          while (xxinkey(ch) = 0) do begin
  176.         end;
  177.          end;
  178.       if (ch = chr(27)) then menuit := 0
  179.       else menuit := i;
  180.       popscreen;
  181.       end;
  182.  
  183.     function showit(var choices : menu_c;
  184.      const title : lstring ) : integer [public];
  185.  
  186.        var
  187.       max_len : integer;
  188.       max_items : integer;
  189.       i,j,k : integer;
  190.       x,y : integer;
  191.       sx, sy : integer;
  192.       scr : ads of screen;
  193.       ch : char;
  194.  
  195.        begin
  196.       pushscreen;
  197.       max_len := 2 + ord(title.len);
  198.       for i := 1 to upper(choices) do begin
  199.          if (choices[i].len = 0) then break;
  200.          if (ord(choices[i].len) > max_len) then max_len := ord(choices[i].
  201.           len);
  202.          end;
  203.       max_items := i-1;
  204.       if (max_items = 0) then begin
  205.          showit := 0;
  206.          return;
  207.          end;
  208.       max_len := max_len + 2;
  209.       sx := 40 - ((max_len + 2) div 2);
  210.       sy := 12 - ((max_items + 2) div 2);
  211.       xxmove(sx,sy-2);
  212.       xttywrt('╔',7);
  213.       for i := 1 to max_len do xttywrt('═',7);
  214.       xttywrt('╗',7);
  215.       xxmove(sx,sy-1);
  216.       xwca(#700, max_len+1);
  217.       xxmove(40 - (ord(title.len) div 2), sy-1);
  218.       xttywrt(title, 7);
  219.       xxmove(sx,sy-1);
  220.       xttywrt('║',7);
  221.       xxmove(sx+max_len+1, sy-1);
  222.       xttywrt('║',7);
  223.       xxmove(sx,sy);
  224.       xttywrt('╠',7);
  225.       for i := 1 to max_len do xttywrt('═',7);
  226.       xttywrt('╣',7);
  227.       for i := 1 to max_items do begin
  228.          xxmove(sx,sy+i);
  229.          xwca(#700, max_len+1);
  230.          xxmove(sx,sy+i);
  231.          xttywrt('║',7);
  232.          xxmove(40 - (ord(choices[i].len) div 2), sy+i);
  233.          xttywrt(choices[i], 7);
  234.          xxmove(sx+max_len+1,sy+i);
  235.          xttywrt('║',7);
  236.          end;
  237.       xxmove(sx,sy+1+max_items);
  238.       xttywrt('╚',7);
  239.       for i := 1 to max_len do xttywrt('═',7);
  240.       xttywrt('╝',7);
  241.       i := 1;
  242.       show(sy+2+max_items);
  243.       while (xxinkey(ch) = 0) do begin
  244.          end;
  245.       while ((ch <> ' ') and (ch <> chr(27))) do begin
  246.          while (xxinkey(ch) = 0) do begin
  247.         end;
  248.          end;
  249.       showit := 1;
  250.       popscreen;
  251.       end;
  252.  
  253.     function menutree(const s : string) : integer [public];
  254.  
  255.        var
  256.       menus : array[1..10] of menu_c(20);
  257.       i,j,k,l: integer;
  258.       branches : array[1..20] of array[1..25] of integer;
  259.       titles : array[1..20] of lstring(80);
  260.       fil : text;
  261.       buf : lstring(128);
  262.       cur_menu, cur_choice : integer;
  263.       ch : char;
  264.  
  265.        begin
  266.       assign(fil, s);
  267.       reset(fil);
  268.       while (not eof(fil)) do begin
  269.          if (eoln(fil)) then begin
  270.         readln(fil);
  271.         read(fil, cur_menu);
  272.         readln(fil, titles[cur_menu]);
  273.         cur_choice := 1;
  274.         cycle;
  275.         end;
  276.          readln(fil, branches[cur_menu, cur_choice], menus[cur_menu,
  277.           cur_choice]);
  278.          cur_choice := cur_choice + 1;
  279.          menus[cur_menu, cur_choice].len := 0;
  280.          end;
  281.       cur_menu := 1;
  282.       cur_choice := 1;
  283.       while (cur_menu > 0) do begin
  284.          cur_choice := menuit(menus[cur_menu], titles[cur_menu]);
  285.          if (cur_choice > 0) then cur_menu := branches[cur_menu, cur_choice]
  286.          else cur_menu := 0;
  287.          end;
  288.       menutree := -1 * cur_menu;
  289.       end;
  290.  end.
  291.